perm filename SMX[MSS,LCS] blob sn#096373 filedate 1974-04-09 generic text, type T, neo UTF8
00010		SUBROUTINE SMOOTH(JQ)
00020		COMMON/ED/KX,NEXT,NN,NX,NY,J/LL/L
00040		COMMON /RC/MCLEF(200),IST(4000)
00060		COMMON /RZ/RSZ,IPLT,RJB,CENTR
00080		COMMON /FL/IC,NJ,NQ,RZ,IXRX,XGP,RXGP
00100		DIMENSION BUF2(700)
00105		COMMON/NFF/NE(513)
00110		DATA INC/4/
00200		COMMON X(100),Y(100),N,X1(512),Y1(512),S(100),K
00220		NOFIL=-1
00230	100	JY=2
00240	8	KX=0
00250		KZ=0
00300		CALL DPYSET(3,BUF2,700)
00310	7	JX=J
00312		KX=KZ
00315		CALL SETPOG(3)
00400		DO 1 K=JY,J
00600		CALL UNPACK(K,JA,JB,MCLEF)
00602		IF(L.GE.100000000.AND.K.GT.JY)GO TO 6
00603	C  JUMP WHEN INVIS. VECT.
00605		KX=KX+1
00610		X(KX)=(JA+RJB)*RSZ
00620	1	Y(KX)=(JB+CENTR)*RSZ
00630	9	X(KX+1)=999.
01300	4	N=KX
01900		CALL SS
01950		IF(JQ.NE.' ')CALL HYDPOG(1)
02050		RZ=RSZ
02060		IF(IXRX)RZ=RZ*1.7
02070		RSZ=1.0
02100		CALL LINES(X1(1),Y1(1),3)
02110		KZ=0
02200		DO 5 K=2,512,INC
02210		KZ=KZ+1
02300		NE(KZ)=0
02310		X1(KZ)=X1(K)
02320		Y1(KZ)=Y1(K)
02350	5	CALL LINES(X1(K),Y1(K),2)
02355		NE(KZ+1)=KA
02360		KA=KZ+2
02370		NE(1)=KZ
02400		CALL DPYOUT(3)
02410		RSZ=RZ
02900		IF(JX.NE.J)GO TO 7
02910		CALL SETPOG(1)
02920		IF(NOFIL)RETURN
02950		CALL FILLQ(X1,Y1,NE)
03000		RETURN
05200	6	JY=K
05300		JX=JY
05500		END
05600	
05700		SUBROUTINE EDTYP(K,X,JJJ)
05800		TYPE 57
05900		ACCEPT 1,K,X
06000		IF(K.NE.' ')JJJ=0
06100		IF(K.EQ.':'.OR.JJJ)GO TO 2
06200	C  TYPE "A" OR ":" TO ALTER
06300		IF(K.NE.'G')RETURN
06400		JJJ=-1
06500	2	K='A'
06600		RETURN
06700	57	FORMAT(' TYPE D, A, I OR X ',$)
06800	1	FORMAT(A1,2F)
06900		END
07000	
07100		SUBROUTINE ITYP
07200		COMMON/ED/K,NEXT,NN,NX,NY,J
07300		TYPE 1,NN,NX,NY
07400		RETURN
07500	1	FORMAT(I4,')',2I6)
07600		END
07700	
07800		SUBROUTINE FILLQ(Q,R,N)
07900		DIMENSION Q(1),R(1),N(1)
07910		COMMON /FL/IC,NJ,NQ,RZ,IXRX,XGP,RXGP
07955		COMMON /RZ/RSZ,IPLT,RJB,CENTR
08000		M=6
08100		IF(IPLT)M=1
08200	1	RZ=RSZ
08250		RSZ=1.0
08300		IF(IXRX)RZ=RZ*1.7
08400		CALL FILLER(Q,R,N,M)
08500		RSZ=RZ
08600		END